Technotools/Technotools (Chestnut CD-ROM)(1993).ISO/misc_pto/bcolor20/clredit.m

Text File | 1988-12-17 | 15KB | 631 lines

;************************************************************************
;**                  for   B R I E F   ver. 2.1                         *
;**                                                                     *
;**   Clredit Macro - Create, change and delete colors in color.mnu     *
;**                                                                     *
;**         By Tom Bentley     December 1988     Ver. 2.0               *
;**                                                                     *
;**                 (C) Copyright - All rights reserved                 *
;**                                                                     *
;************************************************************************

(extern    clr_buf_mnu clr_flag clr_buf_mnu clr_last_mnu)

(macro clredit
   (
      (int     curr_buff)

      (= curr_buff (inq_buffer))
      (create_window 28 19 53 3 "(Edit,Del,Move Esc)")
      (set_buffer clr_buf_mnu)
      (attach_buffer clr_buf_mnu)
      (keyboard_push)
      (assign_to_key "<Down-Arrow>" "menu_down")
      (assign_to_key "<Up-Arrow>" "menu_up")
      (assign_to_key "<Enter>" "clr_edit")
      (assign_to_key "E" "clr_edit")
      (assign_to_key "e" "clr_edit")
      (assign_to_key "d" "clr_del 0")
      (assign_to_key "D" "clr_del 0")
      (assign_to_key "m" "clr_move")
      (assign_to_key "M" "clr_move")
      (assign_to_key "<Esc>" "exit")
      (goto_line 1)
      (drop_anchor 3)
      (refresh)
      (process)
      (keyboard_pop)
      (raise_anchor)
      (set_buffer curr_buff)
      (delete_window)
      (message " ")
      (set_buffer clr_buf_mnu)
      (if (inq_modified)
         (
            (write_buffer)
         )
      )
      (= clr_last_mnu 1)
      (= clr_flag 0)
      (while (== 0 clr_flag)
         (
            (goto_line clr_last_mnu)
            (if (! (inq_position clr_last_mnu))
               (++ clr_last_mnu)
            ;else
               (= clr_flag 1)
            )
         )
      )
      (set_buffer curr_buff)
   )
)

(macro menu_up
   (
      (if (! (up))
         (
            (return 0)
         )
      ;else
         (
            (raise_anchor)
            (drop_anchor 3)
            (return 1)
         )
      )
   )
)

(macro menu_down
   (
      (down)
      (if (inq_position)
         (
            (up)
            (return 0)
         )
      ;else
         (
            (raise_anchor)
            (drop_anchor 3)
            (return 1)
         )
      )
   )
)

(macro clr_move
   (

      (string  clr_line)

      (= clr_line (trim (read)))
      (= clr_flag 0)
      (clr_del 1)
      (refresh)
      (error "Move Color: Up/Down-Insert,Append (I,A)")
      (keyboard_push)
      (assign_to_key "<Down-Arrow>" "menu_down")
      (assign_to_key "<Up-Arrow>" "menu_up")
      (assign_to_key "a" "clr_move_upd 1")
      (assign_to_key "A" "clr_move_upd 1")
      (assign_to_key "i" "clr_move_upd 2")
      (assign_to_key "I" "clr_move_upd 2")
      (process)
      (if (== clr_flag 2)
         (
            (insert "\n")
            (up)
            (beginning_of_line)
         )
      ;else
         (
            (end_of_line)
            (insert "\n")
         )
      )
      (insert clr_line)
      (raise_anchor)
      (beginning_of_line)
      (drop_anchor 3)
      (keyboard_pop)
      (message "Color Moved...")
   )
)

(macro clr_move_upd
   (
      (get_parm 0 clr_flag)
      (exit)
   )
)

(macro clr_del
   (
      (int     clr_del_parm)

      (get_parm 0 clr_del_parm)
      (if (== clr_del_parm 0)
         (
            (if (! (up))
               (
                  (error "Cannot delete default color")
                  (beep)
                  (return 0)
               )
            ;else
               (
                  (down)
               )
            )
         )
      )
      (delete_line)
      (if (inq_position)
         (
            (up)
            (raise_anchor)
            (drop_anchor 3)
         )
      )
      (message "Color deleted...")
   )
)

(macro clr_edit
   (
      (int      clr_edit_buf)
      (int      clr_bg clr_nt clr_st clr_nm clr_em clr_bw clr_last_bg)
      (int      clr_sv_bg clr_sv_nt clr_sv_st clr_sv_nm clr_sv_em clr_sv_bw)

      (string   clr_string clr_desc_str)

      (global   clr_bg clr_nt clr_st clr_nm clr_em clr_bw clr_last_bg)

      (= clr_flag 0)
      (= clr_string (compress (read)))
      (= clr_desc_str (substr clr_string 1 (- (index clr_string ";") 1)))
      (search_fwd ";color")
      (next_char 7)
      (= clr_bg (atoi (read 1)))
      (next_char 2)
      (= clr_nt (atoi (read 2)))
      (next_char 3)
      (= clr_st (atoi (read 2)))
      (next_char 3)
      (= clr_nm (atoi (read 2)))
      (next_char 3)
      (= clr_em (atoi (read 2)))
      (next_char 3)
      (= clr_bw (atoi (read 1)))
      (= clr_sv_bg clr_bg)
      (= clr_sv_nt clr_nt)
      (= clr_sv_st clr_st)
      (= clr_sv_nm clr_nm)
      (= clr_sv_em clr_em)
      (= clr_sv_bw clr_bw)
      (beginning_of_line)
      (= clr_edit_buf (create_buffer "EDIT COLORS" NULL 1))
      (set_buffer clr_edit_buf)
      (top_of_buffer)
      (insert "     Background    =")
      (sprintf clr_string "%2d" clr_bg)
      (insert clr_string)
      (insert ";1\n")
      (insert "    Normal  Text   =")
      (sprintf clr_string "%2d" clr_nt)
      (insert clr_string)
      (insert ";2\n")
      (insert "   Selected Title  =")
      (sprintf clr_string "%2d" clr_st)
      (insert clr_string)
      (insert ";3\n")
      (insert "   Normal Message  =")
      (sprintf clr_string "%2d" clr_nm)
      (insert clr_string)
      (insert ";4\n")
      (insert "   Error  Message  =")
      (sprintf clr_string "%2d" clr_em)
      (insert clr_string)
      (insert ";5\n")
      (insert " Borderless Window =")
      (sprintf clr_string "%d" clr_bw)
      (insert clr_string)
      (insert ";6\n")
      (insert "    Description    =")
      (insert clr_desc_str)
      (insert ";7")
      (goto_line 1)
      (drop_anchor 3)
      (color_it)
      (create_window 3 19 22 11 "F10 to Set")
      (attach_buffer clr_edit_buf)
      (refresh)
      (keyboard_push)
      (assign_to_key "<Down-Arrow>" "sel_down")
      (assign_to_key "<Up-Arrow>" "sel_up")
      (assign_to_key "<Left-Arrow>" "clr_left_right 0")
      (assign_to_key "<Right-Arrow>" "clr_left_right 1")
      (assign_to_key "<Enter>" "clr_desc")
      (assign_to_key "<F10>" "clr_done")
      (assign_to_key "<Esc>" "clr_esc")
      (disp_color_msg)
      (process)
      (goto_line 7)
      (= clr_string (compress (read)))
      (= clr_desc_str (substr clr_string (+ (index clr_string "=") 1)
            (- (index clr_string ";") (+ (index clr_string "=") 1))))
      (keyboard_pop)
      (raise_anchor)
      (color clr_sv_bg clr_sv_nt clr_sv_st clr_sv_nm clr_sv_em)
      (delete_window)
      (delete_buffer clr_edit_buf)
      (set_buffer clr_buf_mnu)
      (if (== clr_flag 1)
         (clr_update clr_desc_str)
      )
   )
)

(macro sel_down
   (
      (if (menu_down)
         (
            (color_it)
            (disp_color_msg)
         )
      )
   )
)

(macro sel_up
   (
      (if (menu_up)
         (
            (color_it)
            (disp_color_msg)
         )
      )
   )
)

(macro clr_left_right
   (

      (int     clr_l_r clr_line)

      (get_parm 0 clr_l_r)
      (search_fwd ";")
      (right)
      (= clr_line (atoi (read 1)))
      (if (== clr_line 7)
         (
            (beginning_of_line)
            (error "Use Enter key to change Description...")
            (beep)
            (return 0)
         )
      )
      (beginning_of_line)
      (if (== clr_l_r 0)
         (
            (clr_left clr_line)
         )
      ;else
         (
            (clr_right clr_line)
         )
      )
      (color_it)
      (disp_color_msg)
   )
)

(macro clr_left
   (
      (int     clr_line)
      (string  new_clr)

      (get_parm 0 clr_line)
      (switch clr_line
        1
         (
            (if (> clr_bg 0)
               (-- clr_bg)
            ;else
               (= clr_bg 7)
            )
            (sprintf new_clr "=%1d;" clr_bg)
         )
        2
         (
            (if (> clr_nt 0)
               (-- clr_nt)
            ;else
               (= clr_nt 15)
            )
            (sprintf new_clr "=%2d;" clr_nt)
         )
        3
         (
            (if (> clr_st 0)
               (-- clr_st)
            ;else
               (= clr_st 15)
            )
            (sprintf new_clr "=%2d;" clr_st)
         )
        4
         (
            (if (> clr_nm 0)
               (-- clr_nm)
            ;else
               (= clr_nm 15)
            )
            (sprintf new_clr "=%2d;" clr_nm)
         )
        5
         (
            (if (> clr_em 0)
               (-- clr_em)
            ;else
               (= clr_em 15)
            )
            (sprintf new_clr "=%2d;" clr_em)
         )
        6
         (
            (if (> clr_bw 0)
               (-- clr_bw)
            ;else
               (= clr_bw 7)
            )
            (sprintf new_clr "=%1d;" clr_bw)
         )
      )
      (translate "=*;" new_clr 0)
   )
)

(macro clr_right
   (
      (int     clr_line)
      (string  new_clr)

      (get_parm 0 clr_line)
      (switch clr_line
        1
         (
            (if (< clr_bg 7)
               (++ clr_bg)
            ;else
               (= clr_bg 0)
            )
            (sprintf new_clr "=%1d;" clr_bg)
         )
        2
         (
            (if (< clr_nt 15)
               (++ clr_nt)
            ;else
               (= clr_nt 0)
            )
            (sprintf new_clr "=%2d;" clr_nt)
         )
        3
         (
            (if (< clr_st 15)
               (++ clr_st)
            ;else
               (= clr_st 0)
            )
            (sprintf new_clr "=%2d;" clr_st)
         )
        4
         (
            (if (< clr_nm 15)
               (++ clr_nm)
            ;else
               (= clr_nm 0)
            )
            (sprintf new_clr "=%2d;" clr_nm)
         )
        5
         (
            (if (< clr_em 15)
               (++ clr_em)
            ;else
               (= clr_em 0)
            )
            (sprintf new_clr "=%2d;" clr_em)
         )
        6
         (
            (if (< clr_bw 7)
               (++ clr_bw)
            ;else
               (= clr_bw 0)
            )
            (sprintf new_clr "=%1d;" clr_bw)
         )
      )
      (translate "=*;" new_clr 0)
   )
)

(macro clr_desc
   (
      (string  get_desc clr_read trans_string)

      (= clr_read (compress (read)))
      (search_fwd ";")
      (right)
      (if (!= (atoi (read 1)) 7)
         (
            (beginning_of_line)
            (beep)
            (error "Enter valid for Description only (F10 to Set)")
            (return 0)
         )
      )
      (beginning_of_line)
      (get_parm NULL get_desc "Enter Description : " 24
         (substr clr_read (+ (index clr_read "=") 1)
            (- (index clr_read ";") (+ (index clr_read "=") 1))))
      (if (search_string ";" get_desc)
         (
            (error "Invalid character (;) in description...")
            (return 0)
         )
      )
      (sprintf trans_string "=%s;" get_desc)
      (translate "=*;" trans_string 0)
      (disp_color_msg)
   )
)

(macro clr_done
   (
      (int     error_flag)

      (= error_flag 0)

      (if (|| (== clr_bg clr_nt) (== clr_bg clr_st))
         (= error_flag 1)
      )
      (if (|| (== clr_bg clr_nm) (== clr_bg clr_em))
         (= error_flag 1)
      )
      (if (|| (== clr_bw clr_nt) (== clr_bw clr_st))
         (= error_flag 1)
      )
      (if (|| (== clr_bw clr_nm) (== clr_bw clr_em))
         (= error_flag 1)
      )
      (if (== error_flag 1)
         (
            (error "COLOR ERROR - A text color = a background color")
            (return 0)
         )
      )
      (message " ")
      (= clr_flag 1)
      (exit)
   )
)

(macro clr_esc
   (
      (message " ")
      (exit)
   )
)

(macro color_it
   (
      (int     clr_line)

      (search_fwd ";")
      (right)
      (= clr_line (atoi (read 1)))
      (beginning_of_line)
      (if (|| (== clr_line 1) (== clr_line 7))
         (= clr_last_bg clr_bg)
      ;else
         (if (== clr_line 6)
            (= clr_last_bg clr_bw)
         )
      )
      (color clr_last_bg clr_nt clr_st clr_nm clr_em)
   )
)

(macro disp_color_msg
   (
      (string  clr_read)

      (= clr_read (compress (read)))
      (search_fwd ";")
      (right)
      (if (== (atoi (read 1)) 5)
         (
            (error "%s" (substr clr_read 1 (- (index clr_read ";") 1)))
         )
      ;else
         (
            (message "%s" (substr clr_read 1 (- (index clr_read ";") 1)))
         )
      )
      (beginning_of_line)
   )
)

(macro clr_update
   (
      (int     clr_ins_mode)
      (string  clr_desc_str work_str)

      (refresh)
      (keyboard_push)
      (beginning_of_line)
      (get_parm 0 clr_desc_str)
      (error "New Color: Up/Down - Chg,Ins,Append (C,I,A)")
      (assign_to_key "<Down-Arrow>" "menu_down")
      (assign_to_key "<Up-Arrow>" "menu_up")
      (assign_to_key "c" "clr_upd 0")
      (assign_to_key "C" "clr_upd 0")
      (assign_to_key "a" "clr_upd 1")
      (assign_to_key "A" "clr_upd 1")
      (assign_to_key "i" "clr_upd 2")
      (assign_to_key "I" "clr_upd 2")
      (process)
      (raise_anchor)
      (= clr_ins_mode (insert_mode 1))
      (if (== clr_flag 0)
         (
            (= clr_flag 2)
            (delete_line)
         )
      )
      (if (== clr_flag 2)
         (
            (insert "\n")
            (up)
            (beginning_of_line)
         )
      ;else
         (
            (end_of_line)
            (insert "\n")
         )
      )
      (sprintf work_str "%-24s;color " clr_desc_str)
      (insert work_str)
      (sprintf work_str "%1d " clr_bg)
      (insert work_str)
      (sprintf work_str "%2d " clr_nt)
      (insert work_str)
      (sprintf work_str "%2d " clr_st)
      (insert work_str)
      (sprintf work_str "%2d " clr_nm)
      (insert work_str)
      (sprintf work_str "%2d;" clr_em)
      (insert work_str)
      (sprintf work_str "%1d " clr_bw)
      (insert work_str)
      (insert_mode clr_ins_mode)
      (beginning_of_line)
      (drop_anchor 3)
      (keyboard_pop)
      (message " ")
   )
)

(macro clr_upd
   (
      (get_parm 0 clr_flag)
      (exit)
   )
)